home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / jock.zip / TOTSRC11.ZIP / TOTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-08  |  56KB  |  2,065 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10e                            }
  6.  
  7. Unit totLIST;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.      1.00a   4/03/91   Corrected Dispose problem in BrowseFileOBJ when
  13.                        file not found.
  14.      1.00b   5/06/91   Added close statement in AssignFile
  15.      1.00c   5/09/91   Added GetSelectedPick to ListOBJ
  16.      1.00d   5/23/91   Added reaction to Mouse method 1
  17.      1.00e   5/28/91   Initialized vActiveDir in ReadFiles
  18.      1.00f   5/30/91   Changed allow toggle logic for String arrays
  19.      1.00g   7/15/91   Added SetChangeDir to ListDirOBJ
  20.      1.00h  10/03/91   Added a char hook to ListDirOBJ
  21.      1.00i  11/06/91   Changed memory checking in ListArrayOBJ.AssignList
  22.      1.00j  01/16/91   Corrected range check error on scroll bar
  23.      1.00k  10/02/92   Changed ReadFiles when path/drive specified
  24.      1.10a  02/23/93   Corrected filemask problem introduced in 1.00k
  25.      1.10b  04/13/93   Changed AssignFile retcode to 2 when no memory
  26.      1.10c  05/03/93   Initialized vLastKey in ListOBJ.Init
  27.                        & Added ListLinkOBJ.RefreshList
  28.                        & Changed Individual Item Selection to Double Click
  29.      1.10d  05/14/93   Corrected Total File Count when FillList called
  30.      1.10e  06/06/93   Wait for mouse release on Double Click
  31. }
  32. INTERFACE
  33.  
  34. Uses DOS,
  35.      totSYS, totLOOK, totFAST, totWIN, totINPUT, totLINK, totSTR, totIO1;
  36.  
  37. TYPE
  38. tListAction = (Finish,Refresh,None);
  39. ListCharFunc = function(var K:word; var X,Y: byte; HiPick:longint): tListAction;
  40. ListMsgFunc = function(HiPick:longint):string;
  41.  
  42. pBrowseOBJ = ^BrowseOBJ;
  43. BrowseOBJ = object
  44.    vWin: StretchWinPtr;
  45.    vTopPick: longint;         {number of first pick in window}
  46.    vTotPicks: longint;        {total number of picks}
  47.    vListVisible: boolean;     {is list on display}
  48.    vListAssigned: boolean;    {is data assigned to list}
  49.    vActivePick: integer;      {the offset of the active pick from the top}
  50.    vRows: integer;            {total number of visible rows}
  51.    vStartCol : longint;       {string position of first character}
  52.    vEndCol: longint;          {rightmost column for scrolling}
  53.    vRealColWidth: byte;       {max avail column width}
  54.    vLastKey: word;            {last key the user pressed}
  55.    {methods ...}
  56.    constructor Init;
  57.    procedure   SetTopPick(TopPick: longint);
  58.    procedure   SetStartCol(Column: longint);
  59.    procedure   SetEndCol(Column: longint);
  60.    function    Win:StretchWinPtr;
  61.    procedure   DisplayPick(Pick:integer);
  62.    procedure   DisplayAllPicks;
  63.    procedure   ScrollUp;
  64.    procedure   ScrollDown;
  65.    procedure   ScrollPgUp;
  66.    procedure   ScrollPgDn;
  67.    procedure   ScrollFirst;
  68.    procedure   ScrollLast;
  69.    procedure   SlideLeft;
  70.    procedure   SlideRight;
  71.    procedure   ScrollFarRight;
  72.    procedure   ScrollFarLeft;
  73.    procedure   ScrollJumpH(X,Y:byte);
  74.    procedure   ScrollJumpV(X,Y:byte);
  75.    function    LastKey: word;
  76.    procedure   Remove;
  77.    procedure   Show;
  78.    procedure   ResetDimensions;
  79.    procedure   Go;
  80.    function    GetString(Pick, Start,Finish: longint):string;  VIRTUAL;
  81.    destructor  Done;                                           VIRTUAL;
  82. end; {BrowseOBJ}
  83.  
  84. pBrowseArrayOBJ = ^BrowseArrayOBJ;
  85. BrowseArrayOBJ = Object (BrowseOBJ)
  86.    vArrayPtr: pointer;
  87.    vStrLength: byte;
  88.    {methods ...}
  89.    constructor Init;
  90.    procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
  91.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  92.    destructor  Done;                                           VIRTUAL;
  93. end; {BrowseArrayOBJ}
  94.  
  95. pBrowseLinkOBJ = ^BrowseLinkOBJ;
  96. BrowseLinkOBJ = Object (BrowseOBJ)
  97.    vLinkList: ^DLLOBJ;
  98.    {methods ...}
  99.    constructor Init;
  100.    procedure   AssignList(var LinkList: DLLOBJ);
  101.    function    ListPtr: DLLPtr;
  102.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  103.    destructor  Done;    VIRTUAL;
  104. end; {BrowseLinkOBJ}
  105.  
  106. pBrowseFileOBJ = ^BrowseFileOBJ;
  107. BrowseFileOBJ = Object (BrowseOBJ)
  108.    vStrList: ^StrDLLOBJ;
  109.    {methods ...}
  110.    constructor Init;
  111.    function    AssignFile(Filename: string):integer;
  112.    function    ListPtr: StrDLLPtr;
  113.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  114.    destructor  Done;    VIRTUAL;
  115. end; {BrowseFileOBJ}
  116.  
  117. pListOBJ = ^ListOBJ;
  118. ListOBJ = object
  119.    vWin: StretchWinPtr;       {pointer to a window}
  120.    vMargin: tByteCoords;      {padding around window border}
  121.    vZone: tByteCoords;        {outer window dimensions}
  122.    vTopPick: longint;         {number of first pick in window}
  123.    vTotPicks: longint;        {total number of picks}
  124.    vAllowToggle: boolean;     {can user select items in list}
  125.    vListVisible: boolean;     {is list on display}
  126.    vListAssigned: boolean;    {is data assigned to list}
  127.    vLastChar: word;           {last key user pressed}
  128.    vColWidth: byte;           {user set column width in list display: 0 = max}
  129.    vNAttr: byte;              {normal attribute/color}
  130.    vSAttr: byte;              {attribute for special items}
  131.    vHAttr: byte;              {highlighted topic attribute/color}
  132.    vActivePick: integer;      {the offset of the active pick from the top}
  133.    vRows: integer;            {total number of visible rows}
  134.    vCols: integer;            {Total number of visible columns}
  135.    vRealColWidth: byte;       {max avail column width}
  136.    vLastColWidth: byte;       {width of right most column}
  137.    vUseLastCol: boolean;      {use the last column for highlighting or too narrow}
  138.    vLastKey: word;            {last key the user pressed}
  139.    vCharHook: ListCharFunc;   {character hook}
  140.    vMsgHook: ListMsgFunc;     {message hook}
  141.    vMsgActive: boolean;       {is Msg hook enabled}
  142.    vDualColors: boolean;      {should list use SAttr and NAttr}
  143.    {methods ...}
  144.    constructor Init;
  145.    procedure   SetTopPick(TopPick: longint);
  146.    procedure   SetActivePick(ThePick: LongInt);
  147.    procedure   SetTagging(On:boolean);
  148.    procedure   SetColors(HAttr,NAttr,SAttr: byte);
  149.    procedure   SetColWidth(Wid: byte);
  150.    procedure   SetCharHook(Func:ListCharFunc);
  151.    procedure   SetMsgHook(Func:ListMsgFunc);
  152.    procedure   SetMsgState(On:boolean);
  153.    procedure   SetDualColors(On:Boolean);
  154.    function    GetHiString:string;
  155.    function    GetSelectedPick: longint;
  156.    function    Win:StretchWinPtr;
  157.    procedure   ResetDimensions;
  158.    procedure   DisplayPick(Pick:integer; Hi:boolean);
  159.    procedure   DisplayAllPicks;
  160.    procedure   RefreshList;
  161.    procedure   Remove;
  162.    procedure   ValidateActivePick;
  163.    procedure   ScrollUp;
  164.    procedure   ScrollDown;
  165.    procedure   JumpEngine(Tot, NewValue: longint);
  166.    procedure   ScrollJumpV(X,Y:byte);
  167.    procedure   ScrollJumpH(X,Y:byte);
  168.    procedure   ScrollLeft;
  169.    procedure   ScrollFarLeft;
  170.    procedure   ScrollRight;
  171.    procedure   ScrollFarRight;
  172.    procedure   ScrollPgDn;
  173.    procedure   ScrollPgUp;
  174.    procedure   ScrollFirst;
  175.    procedure   ScrollLast;
  176.    procedure   ToggleSelect;
  177.    function    TargetPick(X,Y:byte): Integer;
  178.    procedure   MouseChoose(KeyX,KeyY:byte);
  179.    function    LastKey: word;
  180.    procedure   Go;
  181.    procedure   Show;
  182.    function    CharTask(var K:word; var X,Y: byte; 
  183.                         HiPick:longint): tListAction;          VIRTUAL;
  184.    function    MessageTask(HiPick:longint):string;             VIRTUAL;
  185.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  186.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  187.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  188.    procedure   TagAll(On:boolean);                             VIRTUAL;
  189.    destructor  Done;                                           VIRTUAL;
  190. end; {ListOBJ}
  191.  
  192. pListArrayOBJ = ^ListArrayOBJ;
  193. ListArrayOBJ = object (ListOBJ)
  194.    vArrayPtr: pointer;
  195.    vStrLength: byte;
  196.    vLinkList: ^DLLOBJ;
  197.    {methods ...}
  198.    constructor Init;
  199.    procedure  AssignList(var StrArray; Total:Longint; StrLength:byte;Selectable: boolean);
  200.    procedure  SetTagging(On:boolean);
  201.    function   GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  202.    function   GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  203.    procedure  SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  204.    procedure  TagAll(On:boolean);                             VIRTUAL;
  205.    destructor Done;                                           VIRTUAL;
  206. end; {of object ListArrayOBJ}
  207.  
  208. pListLinkOBJ = ^ListLinkOBJ;
  209. ListLinkOBJ = object (ListOBJ)
  210.    vLinkList: ^DLLOBJ;
  211.    {methods ...}
  212.    constructor Init;
  213.    procedure   AssignList(var LinkList: DLLOBJ);
  214.    function    ListPtr: DLLPtr;
  215.    procedure   RefeshList;
  216.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  217.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  218.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  219.    procedure   TagAll(On:boolean);                             VIRTUAL;
  220.    destructor  Done;                                           VIRTUAL;
  221. end; {ListLinkOBJ}
  222.  
  223. pListDirOBJ = ^ListDirOBJ;
  224. ListDirOBJ = object (ListOBJ)
  225.    vFileList: ^FileDLLOBJ;
  226.    vActiveDir: PathStr;
  227.    vChangeDir: boolean;
  228.    {methods ...}
  229.    constructor Init;
  230.    procedure   SetChangeDir(On:boolean);
  231.    procedure   ReadFiles(FileMasks:string; FileAttrib: word);
  232.    function    GetHiString: string;
  233.    procedure   Go;
  234.    function    FileList:FileDLLPtr;
  235.    function    CharTask(var K:word; var X,Y: byte;
  236.                         HiPick:longint): tListAction;          VIRTUAL;
  237.    function    MessageTask(Hi:longint): string;                VIRTUAL;
  238.    function    GetString(Pick, Start,Finish:longint): string;  VIRTUAL;
  239.    function    GetStatus(Pick:longint;BitPos:byte): boolean;   VIRTUAL;
  240.    procedure   SetStatus(Pick:longint;BitPos:byte;On:boolean); VIRTUAL;
  241.    procedure   TagAll(On:boolean);                             VIRTUAL;
  242.    destructor  Done;                                           VIRTUAL;
  243. end; {ListDirOBJ}
  244.  
  245. pListDirSortOBJ = ^ListDirSortOBJ;
  246. ListDirSortOBJ = object (ListDirOBJ)
  247.    constructor Init;
  248.    function    PromptAndSort: boolean;
  249.    function    CharTask(var K:word; var X,Y: byte;
  250.                         HiPick:longint): tListAction;          VIRTUAL;
  251.    destructor  Done;                                           VIRTUAL;
  252. end; {ListDirSortOBJ}
  253. procedure ListInit;
  254.  
  255. IMPLEMENTATION
  256. {|||||||||||||||||||||||||||||||||||||||||||||}
  257. {                                             }
  258. {     M i s c.  P r o c s   &   F u n c s     }
  259. {                                             }
  260. {|||||||||||||||||||||||||||||||||||||||||||||}
  261. {$F+}
  262. function NoCharHook(var K:word; var X,Y: byte; HiPick:longint): tListAction;
  263. {}
  264. begin
  265.    NoCharHook := None;
  266. end; {NoCharHook}
  267.  
  268. function NoMsgHook(HiPick:longint):string;
  269. {}
  270. begin
  271.    NoMsgHook := '';
  272. end; {NoEnterHook}
  273. {$IFNDEF OVERLAY}
  274.    {$F-}
  275. {$ENDIF}
  276.  
  277. procedure Error(Err:byte);
  278. {routine to display error}
  279. const
  280.    Header = 'totLIST error: ';
  281. var
  282.    Msg : string;
  283. begin
  284.    Case Err of
  285.    1: Msg := 'A list Must be assigned before calling SHOW or GO';
  286.    else  Msg := 'Unknown Error';
  287.    end; {case}
  288.    Writeln(Header,Msg);
  289. {Maybe Add non-fatal compiler directive}
  290.    halt;
  291. end; {Error}
  292. {||||||||||||||||||||||||||||||||||||||||||}
  293. {                                          }
  294. {    B r o w s e O B J   M E T H O D S     }
  295. {                                          }
  296. {||||||||||||||||||||||||||||||||||||||||||}
  297. constructor BrowseOBJ.Init;
  298. {}
  299. begin
  300.    new(vWin,Init);
  301.    vWin^.SetScrollable(true,true);
  302.    vTopPick := 1;
  303.    vTotPicks := 1;
  304.    vListAssigned := false;
  305.    vListVisible := false;
  306.    vStartCol := 1;
  307.    vEndCol := 80;
  308.    vActivePick := 1;
  309.    vRows := 0;
  310. end; {BrowseOBJ.Init}
  311.  
  312. function BrowseOBJ.Win:StretchWinPtr;
  313. {}
  314. begin
  315.    Win := vWin;
  316. end; {BrowseOBJ.Win}
  317.  
  318. procedure BrowseOBJ.SetTopPick(TopPick: longint);
  319. {}
  320. begin
  321.    vTopPick := TopPick;
  322. end; {BrowseOBJ.SetTopElement}
  323.  
  324. procedure BrowseOBJ.SetStartCol(Column: longint);
  325. {}
  326. begin
  327.    vStartCol := Column;
  328. end; {BrowseOBJ.SetStartCol}
  329.  
  330. procedure BrowseOBJ.SetEndCol(Column: longint);
  331. {}
  332. begin
  333.    if (Column > vStartCol) or (Column = 0) then
  334.       vEndCol := Column
  335.    else
  336.       vEndCol := vStartCol;
  337. end; {BrowseOBJ.SetEndCol}
  338.  
  339. function BrowseOBJ.GetString(Pick, Start,Finish: longint):string;
  340. {abstract}
  341. begin end;
  342.  
  343. procedure BrowseOBJ.DisplayPick(Pick:integer);
  344. {}
  345. var
  346.   PickStr: string;
  347. begin
  348.    if pred(vTopPick + Pick) <= vTotPicks then
  349.       PickStr := GetString(pred(vTopPick + Pick),vStartCol,pred(vStartCol)+vRealColWidth)
  350.    else
  351.       PickStr := '';
  352.    PickStr := padleft(PickStr,vRealColWidth,' ');
  353.    Screen.WritePlain(1,Pick,PickStr);
  354. end; {BrowseOBJ.DisplayPick}
  355.  
  356. procedure BrowseOBJ.DisplayAllPicks;
  357. {}
  358. var I : integer;
  359. begin
  360.    for I := 1 to vRows do
  361.        DisplayPick(I);
  362. end; {BrowseOBJ.DisplayAllPicks}
  363.  
  364. procedure BrowseOBJ.ScrollUp;
  365. {}
  366. begin
  367.   if vTopPick > 1 then
  368.   begin
  369.      dec(vTopPick);
  370.      DisplayAllPicks;
  371.   end;
  372. end; {BrowseOBJ.ScrollUp}
  373.  
  374. procedure BrowseOBJ.ScrollDown;
  375. {}
  376. begin
  377.    if vTopPick < vTotPicks then
  378.    begin
  379.       inc(vTopPick);
  380.       DisplayAllPicks;
  381.    end;
  382. end; {BrowseOBJ.ScrollDown}
  383.  
  384. procedure BrowseOBJ.SlideLeft;
  385. {}
  386. begin
  387.    if vStartCol > 1 then
  388.    begin
  389.       dec(vStartCol);
  390.       DisplayAllPicks;
  391.    end;                      
  392. end; {BrowseOBJ.SlideLeft}
  393.  
  394. procedure BrowseOBJ.SlideRight;
  395. {}
  396. begin
  397.    if (vEndCol = 0) or (vStartCol < vEndCol) then
  398.    begin
  399.       inc(vStartCol);
  400.       DisplayAllPicks;
  401.    end;
  402. end; {BrowseOBJ.SlideRight}
  403.  
  404. procedure BrowseOBJ.ScrollPgUp;
  405. {}
  406. begin
  407.    if vTopPick > 1 then
  408.    begin
  409.       dec(vTopPick,vRows);
  410.       if vTopPick < 1 then
  411.          vTopPick := 1;
  412.       DisplayAllPicks;
  413.    end;
  414. end; {BrowseOBJ.ScrollPgUp}
  415.  
  416. procedure BrowseOBJ.ScrollPgDn;
  417. {}
  418. begin
  419.    if pred(vTopPick + vRows) < vTotPicks then
  420.    begin
  421.       inc(vTopPick,vRows);
  422.       DisplayAllPicks;
  423.    end;
  424. end; {BrowseOBJ.ScrollPgDn}
  425.  
  426. procedure BrowseOBJ.ScrollFarRight;
  427. {}
  428. var EndCol: longint;
  429. begin
  430.    if (vEndCol = 0) then
  431.       EndCol := 255
  432.    else
  433.       EndCol := vEndCol;
  434.    if (vStartCol < EndCol - pred(vRealColWidth)) then
  435.    begin
  436.       vStartCol := EndCol - pred(vRealColWidth);
  437.       DisplayAllPicks;
  438.    end;
  439. end; {BrowseOBJ.ScrollFarRight}
  440.  
  441. procedure BrowseOBJ.ScrollFarLeft;
  442. {}
  443. begin
  444.    if vStartCol > 1 then
  445.    begin
  446.       vStartCol := 1;
  447.       DisplayAllPicks;
  448.    end; 
  449. end; {BrowseOBJ.ScrollFarLeft}
  450.  
  451. procedure BrowseOBJ.ScrollLast;
  452. {}
  453. begin
  454.    if pred(vTopPick) + vRows <> vTotPicks then
  455.    begin
  456.       vTopPick := succ(vTotPicks) - vRows;
  457.       DisplayAllPicks;
  458.    end;
  459. end; {BrowseOBJ.ScrollLast}
  460.  
  461. procedure BrowseOBJ.ScrollFirst;
  462. {}
  463. begin
  464.    if vTopPick <> 1 then
  465.    begin
  466.       vTopPick := 1;
  467.       DisplayAllPicks;
  468.    end;
  469. end; {BrowseOBJ.ScrollFirst}
  470.  
  471. procedure BrowseOBJ.ScrollJumpH(X,Y:byte);
  472. {}
  473. var NewStart: longint;
  474. begin
  475.    if X = 1 then
  476.       NewStart := 1
  477.    else if X=Y then
  478.       NewStart := vEndCol
  479.    else
  480.       NewStart := (X * vEndCol) div Y;
  481.    if NewStart < 1 then                  {1.00j}
  482.       NewStart := 1;
  483.    if NewStart <> vStartCol then
  484.    begin
  485.       vStartCol := NewStart;
  486.       DisplayAllPicks;
  487.    end;
  488. end; {BrowseOBJ.ScrollJumpH}
  489.  
  490. procedure BrowseOBJ.ScrollJumpV(X,Y:byte);
  491. {}
  492. var NewTop: longint;
  493. begin
  494.    if X = 1 then
  495.       NewTop := 1
  496.    else if X=Y then
  497.       NewTop := vTotPicks
  498.    else
  499.       NewTop := (X * vTotPicks) div Y;
  500.    if NewTop < 1 then              {1.00j}
  501.       NewTop := 1;
  502.    if NewTop <> vTopPick then
  503.    begin
  504.       vTopPick := NewTop;
  505.       DisplayAllPicks;
  506.    end;
  507. end; {BrowseOBJ.ScrollJumpV}
  508.  
  509. procedure BrowseOBJ.Go;
  510. {}
  511. var
  512.    Finished: boolean;
  513.    Mvisible: boolean;
  514.    K: word;
  515.    X,Y :byte;
  516.    CX,CY,CT,CB:byte;
  517. begin
  518.    Mvisible := Mouse.Visible;
  519.    if Monitor^.ColorOn then
  520.       with Screen do
  521.       begin
  522.          CursSave;
  523.          CX := WhereX;
  524.          CY := WhereY;
  525.          CT := CursTop;
  526.          CB := CursBot;
  527.          CursOff;
  528.       end;
  529.    Show;
  530.    Finished := false;
  531.    repeat
  532.       vWin^.DrawHorizBar(vStartCol,vEndCol);
  533.       vWin^.DrawVertBar(vTopPick,vTotPicks);
  534.       K := Key.GetKey;
  535.       X := Key.LastX;
  536.       Y := Key.LastY;
  537.       vWin^.Winkey(K,X,Y);
  538.       if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
  539.          Finished := true
  540.       else
  541.          case K of
  542.          600: Finished := true; {window close}
  543.          602: begin
  544.             ResetDimensions;
  545.             DisplayAllPicks; {window stretched}
  546.             end;
  547.          610,328,584: ScrollUp; {1.00d}
  548.          611,336,592: ScrollDown;
  549.          612,331,589: SlideLeft;
  550.          613,333,587: SlideRight;
  551.          337: ScrollPgDn;
  552.          329: ScrollPgUp;
  553.          335: ScrollFarRight;
  554.          327: ScrollFarLeft;
  555.          388: ScrollFirst;
  556.          374: ScrollLast;
  557.          614: ScrollJumpV(X,Y);
  558.          615: ScrollJumpH(X,Y);
  559.          end; {case}
  560.    until Finished;
  561.    vLastKey := K;
  562.    if Mvisible then
  563.       Mouse.Show
  564.    else
  565.       Mouse.Hide;
  566.    if Monitor^.ColorOn then
  567.       with Screen do
  568.       begin
  569.          GotoXY(CX,CY);
  570.          CursSize(CT,CB);
  571.       end;
  572. end; {BrowseOBJ.Go}
  573.  
  574. procedure BrowseOBJ.Remove;
  575. {}
  576. begin
  577.    vWin^.Remove;
  578. end; {BrowseOBJ.Remove}
  579.  
  580. function BrowseOBJ.LastKey:word;
  581. {}
  582. begin
  583.    LastKey := vLastKey;
  584. end; {BrowseOBJ.LastKey}
  585.  
  586. procedure BrowseOBJ.ReSetDimensions;
  587. {}
  588. var S: byte;
  589. begin
  590.    with vWin^ do
  591.    begin
  592.       S := GetStyle;
  593.       case S of
  594.       0: vRows := succ(vBorder.Y2 - vBorder.Y1);
  595.       6: vRows := vBorder.Y2 - vBorder.Y1 - 3;
  596.       else vRows := pred(vBorder.Y2 - vBorder.Y1)
  597.       end; {case}
  598.       if S in[0,6] then
  599.          vRealColWidth := succ(vBorder.X2 - vBorder.X1)
  600.       else
  601.          vRealColWidth := pred(vBorder.X2 - vBorder.X1);
  602.    end; {with}
  603. end; {Browse.ResetDimensions}
  604.  
  605. procedure BrowseOBJ.Show;
  606. {}
  607. begin
  608.    if vListAssigned = false then
  609.       Error(1)
  610.    else
  611.    begin
  612.       if not vListVisible then
  613.       begin
  614.          vWin^.Draw;
  615.          ResetDimensions;
  616.          DisplayAllPicks;
  617.          vListVisible := true
  618.       end;
  619.    end;
  620. end; {BrowseOBJ.Show}
  621.  
  622. destructor BrowseOBJ.Done;
  623. {}
  624. begin
  625.    dispose(vWin,Done);
  626. end; {BrowseOBJ.Done}
  627. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  628. {                                                     }
  629. {    B r o w s e A r r a y O B J    M E T H O D S     }
  630. {                                                     }
  631. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  632. constructor BrowseArrayOBJ.Init;
  633. {}
  634. begin
  635.    BrowseObj.Init;
  636. end; {BrowseArrayOBJ.Init}
  637.  
  638. procedure BrowseArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
  639. {}
  640. var
  641.   L : Longint;
  642.   Dummy: byte;
  643.   Result : integer;
  644. begin
  645.    vArrayPtr := @StrArray;
  646.    vStrLength := StrLength;
  647.    vTotPicks := Total;
  648.    vListAssigned := true;
  649.    vEndCol := StrLength;
  650. end; {BrowseArrayOBJ.AssignList}
  651.  
  652. function BrowseArrayOBJ.GetString(Pick, Start,Finish: longint):string;
  653. {}
  654. var
  655.   W : word;
  656.   TempStr : String;
  657.   ArrayOffset: word;
  658. begin
  659.    {move array string to Temp}
  660.    W := pred(Pick) * succ(vStrLength);
  661.    ArrayOffset := Ofs(vArrayPtr^) + W;
  662.    Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  663.    Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  664.    if Start < 0 then Start := 0;
  665.    if Finish < 0 then Finish := 0;
  666.    {validate Start and Finish Parameters}
  667.    if ((Finish = 0) and (Start = 0))
  668.    or (Start > Finish) then   {get full string}
  669.    begin
  670.       Start := 1;
  671.       Finish := 255;
  672.    end
  673.    else if Finish - Start > 254 then      {too long to fit in string}
  674.       Finish := Start + 254;
  675.    if Finish > vStrLength then
  676.       Finish := vStrLength;
  677.    if (Start > vStrLength) then
  678.       GetString := ''
  679.    else
  680.    begin
  681.       GetString := copy(TempStr,Start,succ(Finish - Start));
  682.    end;
  683. end; {BrowseArrayOBJ.GetString}
  684.  
  685. destructor BrowseArrayOBJ.Done;
  686. {}
  687. begin
  688.    BrowseObj.Done;
  689. end; {BrowseArrayOBJ.Done}
  690. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  691. {                                                   }
  692. {    B r o w s e L i n k O B J    M E T H O D S     }
  693. {                                                   }
  694. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  695. constructor BrowseLinkOBJ.Init;
  696. {}
  697. begin
  698.    BrowseObj.Init;
  699.    vLinkList := nil;
  700. end; {BrowseLinkOBJ.Init}
  701.  
  702. procedure BrowseLinkOBJ.AssignList(var LinkList: DLLOBJ);
  703. {}
  704. begin
  705.    vLinkList := @LinkList;
  706.    vTotPicks := LinkList.TotalNodes;
  707.    vListAssigned := true;
  708.    vEndCol := LinkList.GetMaxNodeSize;
  709. end; {BrowseLinkOBJ.AssignList}
  710.  
  711. function BrowseLinkOBJ.GetString(Pick,Start,Finish:longint): string;
  712. {}
  713. var TempPtr : DLLNodePtr;
  714. begin
  715.    TempPtr := vLinkList^.NodePtr(Pick);
  716.    if TempPtr <> Nil then
  717.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  718.    GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
  719. end; {BrowseLinkOBJ.GetString}
  720.  
  721. function BrowseLinkOBJ.ListPtr: DLLPtr;
  722. {}
  723. begin
  724.    ListPtr := vLinkList;
  725. end; {BrowseLinkOBJ.ListPtr}
  726.  
  727. destructor BrowseLinkOBJ.Done; 
  728. {}
  729. begin
  730.    BrowseObj.Done;
  731. end; {BrowseLinkOBJ.Done;}
  732. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  733. {                                                   }
  734. {    B r o w s e F i l e O B J    M E T H O D S     }
  735. {                                                   }
  736. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  737. constructor BrowseFileOBJ.Init;
  738. {}
  739. begin
  740.    BrowseOBJ.Init;
  741. end; {BrowseFileOBJ.Init}
  742.  
  743. function BrowseFileOBJ.AssignFile(Filename: string): integer;
  744. {RetCodes:   
  745.          0   OK
  746.          1   File not found
  747.          2   Run out of memory
  748. }
  749. var
  750.    F : text;
  751.    Line : string;
  752.    Result: integer;
  753. begin
  754.    Assign(F,Filename);
  755.    {$I-}
  756.    Reset(F);
  757.    {$I+}
  758.    if IOResult <> 0 then
  759.       AssignFile := 1
  760.    else
  761.    begin
  762.       new(vStrList,Init);
  763.       Result := 0;
  764.       while (eof(F) = false) and (Result = 0) do
  765.       begin
  766.          Readln(F,Line);
  767.          Result := vStrList^.Add(Line);
  768.       end;
  769.       {$I-}
  770.       close(F);         {1.00b}
  771.       {$I+}
  772.       if IOResult <> 0 then
  773.          Result := 1;
  774.       vWin^.SetTitle(filename);
  775.       vListAssigned := true;
  776.       vTotPicks := vStrList^.TotalNodes;
  777.       vEndCol := vStrList^.GetMaxNodeSize;
  778.       if Result = 0 then
  779.          AssignFile := 0
  780.       else
  781.          AssignFile := 2;   {1.10b}
  782.    end;
  783. end; {BrowseFileOBJ.AssignFile}
  784.  
  785. function BrowseFileOBJ.ListPtr:StrDLLPtr;
  786. {}
  787. begin
  788.    ListPtr := vStrList;
  789. end; {BrowseFileOBJ.ListPtr}
  790.  
  791. function BrowseFileOBJ.GetString(Pick,Start,Finish:longint): string;
  792. {}
  793. var TempPtr : DLLNodePtr;
  794. begin
  795.    TempPtr := vStrList^.NodePtr(Pick);
  796.    if TempPtr <> Nil then
  797.       vStrList^.ShiftActiveNode(TempPtr,Pick);
  798.    GetString := vStrList^.GetStr(TempPtr,Start,Finish);
  799. end; {BrowseFileOBJ.GetString}
  800.  
  801. destructor BrowseFileOBJ.Done;   
  802. {}
  803. begin
  804.    BrowseOBJ.Done;
  805.    if vListAssigned then {1.00a}
  806.       dispose(vStrList,Done);
  807. end; {BrowseFileOBJ.Done}
  808. {||||||||||||||||||||||||||||||||||||||}
  809. {                                      }
  810. {    L i s t O B J   M E T H O D S     }
  811. {                                      }
  812. {||||||||||||||||||||||||||||||||||||||}
  813. constructor ListOBJ.Init;
  814. {}
  815. begin                                                                    
  816.    new(vWin,Init);
  817.    vWin^.SetScrollable(true,true);
  818.    vTopPick := 1;
  819.    vTotPicks := 1;
  820.    vActivePick := 1;
  821.    vListVisible := false;
  822.    vListAssigned := false;
  823.    vMsgActive := false;
  824.    vCharHook := NoCharHook;
  825.    vMsgHook := NoMsgHook;
  826.    vAllowToggle  := true;
  827.    vColWidth := 0;
  828.    vHAttr := LookTOT^.MenuHiNorm;
  829.    vNAttr := LookTOT^.MenuLoNorm;
  830.    vSAttr := LookTOT^.MenuOff;
  831.    vWin^.SetColors(0,vNattr,0,0);
  832.    vDualColors := false;
  833.    vLastkey := 0;                         {1.10c}
  834. end; {ListOBJ.Init}
  835.  
  836. procedure ListOBJ.SetTopPick(TopPick: longint);
  837. {}
  838. begin
  839.    vTopPick := TopPick;
  840. end; {ListOBJ.SetTopElement}
  841.  
  842. procedure ListOBJ.SetActivePick(ThePick: longint);
  843. {}
  844. begin
  845.    vActivePick := ThePick;
  846. end; {ListOBJ.SetTopElement}
  847.  
  848. procedure ListOBJ.SetTagging(On:boolean);
  849. {}
  850. begin
  851.    vAllowToggle := On;
  852. end; {ListOBJ.SetTagging}
  853.  
  854. procedure ListOBJ.SetDualColors(On:boolean);
  855. {}
  856. begin
  857.    vDualColors := On;
  858. end; {ListOBJ.SetDualColors}
  859.  
  860. procedure ListOBJ.SetColors(HAttr,NAttr,SAttr: byte);
  861. {}
  862. begin
  863.    vHAttr := HAttr;
  864.    vNAttr := NAttr;
  865.    vSAttr := SAttr;
  866.    vWin^.SetColors(0,vNattr,0,0);
  867. end; {ListOBJ.SetColors}
  868.  
  869. procedure ListOBJ.SetColWidth(Wid: byte);
  870. {}
  871. begin
  872.    vColWidth := Wid;
  873. end; {ListOBJ.SetColumnWidth}
  874.  
  875. procedure ListOBJ.SetCharHook(Func:ListCharFunc);
  876. {}
  877. begin
  878.    vCharHook := Func;
  879. end; {ListOBJ.SetCharHook}
  880.  
  881. procedure ListOBJ.SetMsgHook(Func:ListMsgFunc);
  882. {}
  883. begin
  884.    vMsgHook := Func;
  885.    vMsgActive := true;
  886. end; {ListOBJ.SetMsgHook}
  887.  
  888. procedure ListOBJ.SetMsgState(On:boolean);
  889. {}
  890. begin
  891.    vMsgActive := On;
  892. end; {ListOBJ.SetMsgState}
  893.  
  894. function ListOBJ.GetHiString:string;
  895. {}
  896. begin
  897.    GetHiString := GetString(pred(vTopPick+vActivePick),0,0);
  898. end; {ListOBJ.GetHiString}
  899.  
  900. function ListOBJ.GetSelectedPick: longint;       {1.00c}
  901. {}
  902. begin
  903.    GetSelectedPick := pred(vTopPick+vActivePick);
  904. end; {ListOBJ.GetSelectedPick}
  905.  
  906. function ListOBJ.Win:StretchWinPtr;
  907. {}
  908. begin
  909.    Win := vWin;
  910. end; {ListOBJ.Win}
  911.  
  912. procedure ListOBJ.ResetDimensions;
  913. {adjusts the column and row settings based on the list window coords}
  914. var 
  915.   ListWidth: byte;
  916.   Style: byte;
  917. begin
  918.    with vZone do
  919.       vWin^.GetSize(X1,Y1,X2,Y2,Style);
  920.    if Style = 0 then
  921.       fillchar(vMargin,sizeof(vMargin),#0)
  922.    else
  923.    begin
  924.       vMargin.X1 := 1;
  925.       vMargin.X2 := 1;
  926.       vMargin.Y2 := 1;
  927.       if Style = 6 then
  928.          vMargin.Y1 := 3
  929.       else
  930.          vMargin.Y1 := 1;
  931.    end;
  932.    if vColWidth < 5 then
  933.    begin
  934.       vRealColWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
  935.       vCols := 1;
  936.       vLastColWidth := vRealColWidth;
  937.    end
  938.    else
  939.    begin
  940.       vRealColWidth := vColWidth;
  941.       ListWidth := succ(vZone.X2 - vZone.X1) - vMargin.X1 - vMargin.X2;
  942.       if vRealColWidth > ListWidth then
  943.          vRealColWidth := ListWidth;
  944.       vCols :=  ListWidth div vRealColWidth;
  945.       vLastColWidth := ListWidth - vCols * vRealColWidth;
  946.       if vLastColWidth = 0 then
  947.          vLastColWidth := vRealColWidth
  948.       else
  949.          Inc(vCols);
  950.    end;
  951.    vUseLastCol := (vCols = 1) or (vLastColWidth = vRealColWidth);
  952.    vRows := succ(vZone.Y2 - vZone.Y1) - vMargin.Y1 - vMargin.Y2;
  953.    if vMsgActive then
  954.       dec(vRows,2);  {make space for message}
  955. end; {ListOBJ.ResetDimensions}
  956.  
  957. procedure ListOBJ.DisplayPick(Pick:integer; Hi:boolean);
  958. {}
  959. var
  960.   X,Y,Att,Pad,Max,L: byte;
  961.   W : LongInt;
  962.   Partial,
  963.   Selected: boolean;
  964.   PadLeft,PadRight: string[1];
  965.   PickStr : String;
  966.   LeftChar,
  967.   RightChar,
  968.   ToggleOnChar,
  969.   ToggleOffChar : char;
  970. begin
  971.    if vTotPicks = 0 then
  972.       exit;
  973.    LeftChar := LookTOT^.ListLeftChar;
  974.    RightChar := LookTOT^.ListRightChar;
  975.    ToggleOnChar := LookTOT^.ListToggleOnChar;
  976.    ToggleOffChar := LookTOT^.ListToggleOffChar;
  977.    Partial := (vCols > 1) and (Pick > vRows * Pred(vCols))
  978.                           and (vLastColWidth <> vRealColWidth);
  979.    If pred(vTopPick + Pick) > vTotPicks then
  980.    begin
  981.       Att := vNAttr;
  982.       if not Partial then
  983.          PickStr := replicate(vRealColWidth,' ')
  984.       else
  985.          PickStr := replicate(vLastColWidth,' ');
  986.    end
  987.    else
  988.    begin
  989.       Selected := false;
  990.       Pad := ord(LeftChar<>#0) + 2*ord(vAllowToggle);
  991.       if not Partial then
  992.          Pad := Pad + ord(RightChar<>#0);
  993.       if vAllowToggle then
  994.          Selected := GetStatus(pred(vTopPick+Pick), 0);
  995.       if Hi then
  996.          Att := vHAttr
  997.       else
  998.       begin
  999.          if vDualColors and GetStatus(pred(vTopPick+Pick),1) then
  1000.             Att := vSAttr
  1001.          else
  1002.             Att := vNAttr;
  1003.       end;
  1004.       if (vCols = 1) or (Pick <= vRows * pred(vCols)) then
  1005.       begin
  1006.          Max := vRealColWidth;
  1007.          W := vRealColWidth - pad;
  1008.       end
  1009.       else
  1010.       begin
  1011.          Max := vLastColWidth;
  1012.          W := vLastColWidth - pad;
  1013.       end;
  1014.       if W < 0 then
  1015.          PickStr := ''
  1016.       else
  1017.       begin
  1018.          PickStr := GetString(pred(vTopPick + Pick),1,W);
  1019.          L := length(PickStr);
  1020.          If L < W then {pad out the name}
  1021.             PickStr := PickStr + replicate(W-L,' ');
  1022.       end;
  1023.       if vAllowToggle then
  1024.       begin
  1025.          if Selected then
  1026.             PickStr :=  ToggleOnChar+' '+PickStr
  1027.          else
  1028.             PickStr :=  ToggleOffChar+' '+PickStr;
  1029.       end;
  1030.       if Hi then
  1031.       begin
  1032.         if (LeftChar <> #0) then
  1033.            PickStr := LeftChar+PickStr;
  1034.         if (RightChar <> #0) then
  1035.            PickStr := PickStr+RightChar;
  1036.       end
  1037.       else
  1038.       begin
  1039.          if (LeftChar = #0) then
  1040.             Padleft := ''
  1041.          else
  1042.             PadLeft := ' ';
  1043.          if (RightChar = #0) or Partial then
  1044.             PadRight := ''
  1045.          else
  1046.             PadRight := ' ';
  1047.          PickStr := PadLeft+PickStr+PadRight;
  1048.       end;
  1049.       if length(PickStr) > Max then
  1050.          PickStr := copy(PickStr,1,Max);
  1051.    end;
  1052.    if Pick <= vRows then
  1053.       X := 1
  1054.    else
  1055.       X := succ(vRealColWidth*(pred(Pick) div vRows));
  1056.    if Pick mod vRows = 0 then
  1057.       Y := vRows
  1058.    else
  1059.       Y := (Pick mod vRows);
  1060.    {now write the pick}
  1061.    Screen.WriteAT(X,Y,Att,PickStr);
  1062.    if Hi then
  1063.    begin
  1064.       Screen.GotoXY(X,Y);
  1065.       if vMsgActive then
  1066.       begin
  1067.          PickStr := MessageTask(pred(vTopPick+vActivePick));
  1068.          Screen.WriteAt(1,succ(vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1),
  1069.                         vWin^.GetTitleAttr,
  1070.                         PadCenter(PickStr,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),' '));
  1071.       end;
  1072.    end;
  1073. end; {ListOBJ.DisplayPick}
  1074.  
  1075. procedure ListOBJ.DisplayAllPicks;
  1076. {}
  1077. var
  1078.   I,J:integer;
  1079. begin
  1080.    for I := 1 to vCols do
  1081.       for J := 1 to vRows do
  1082.           DisplayPick(pred(I)*vRows + J,(pred(I)*vRows + J) = vActivePick);
  1083. end; {ListOBJ.DisplayAllPicks}
  1084.  
  1085. procedure ListOBJ.ValidateActivePick;
  1086. {}
  1087. var I,J : Integer;
  1088. begin
  1089.    if (vUseLastCol) or (vCols = 1) then
  1090.       I := vCols*vRows
  1091.    else
  1092.       I := pred(vCols)*vRows;
  1093.    if (vActivePick > I) or (vActivePick < 1) then
  1094.       vActivePick := 1;
  1095. end; {ListOBJ.ValidateActivePick}
  1096.  
  1097. procedure ListOBJ.RefreshList;
  1098. {}
  1099. begin
  1100.    ResetDimensions;
  1101.    ValidateActivePick;
  1102.    if vMsgActive then
  1103.    begin
  1104.       Screen.HorizLine(1,succ(vZone.X2 - vZone.X1 - vMargin.X2 - vMargin.X1),
  1105.                          vZone.Y2 - vMargin.Y2 - vZone.Y1 - vMargin.Y1,
  1106.                          Win^.GetBorderAttr,
  1107.                          1);
  1108.    end;
  1109.    DisplayAllPicks;
  1110. end; {ListOBJ.RefreshList}
  1111.  
  1112. procedure ListOBJ.ScrollDown;
  1113. {}
  1114. var LastPick : integer;
  1115. begin
  1116.    if pred(vTopPick + vActivePick) < vTotPicks then {not end of list}
  1117.    begin
  1118.       if (vUseLastCol) or (vCols = 1) then
  1119.          LastPick := vCols*vRows
  1120.       else
  1121.          LastPick := pred(vCols)*vRows;
  1122.       if vActivePick < LastPick then
  1123.       begin
  1124.          DisplayPick(vActivePick,false);
  1125.          inc(vActivePick);
  1126.          DisplayPick(vActivePick,True);
  1127.       end
  1128.       else
  1129.       begin
  1130.          inc(vTopPick);
  1131.          DisplayAllPicks;
  1132.       end;
  1133.    end;
  1134. end; {ListOBJ.ScrollDown}
  1135.  
  1136. procedure ListOBJ.ScrollUp;
  1137. {}
  1138. begin
  1139.    if vActivePick = 1 then
  1140.    begin
  1141.       if vTopPick > 1 then
  1142.       begin
  1143.          dec(vTopPick);
  1144.          DisplayAllPicks;
  1145.       end;
  1146.    end
  1147.    else
  1148.    begin
  1149.       DisplayPick(vActivePick,false);
  1150.       dec(vActivePick);
  1151.       DisplayPick(vActivePick,True);
  1152.    end;
  1153. end; {ListOBJ.ScrollUp}
  1154.  
  1155. procedure ListObj.JumpEngine(Tot, NewValue: longint);
  1156. {}
  1157. var I: Integer;
  1158. begin
  1159.    if NewValue < 1 then
  1160.       NewValue := 1;
  1161.    if (Tot < (vCols - ord(not vUseLastCol)) * vRows)
  1162.    and (vTopPick <= NewValue) then {full list on display}
  1163.    begin
  1164.       DisplayPick(vActivePick,false);
  1165.       vActivePick := NewValue - pred(vTopPick);
  1166.       DisplayPick(vActivePick,True);
  1167.    end
  1168.    else
  1169.    begin
  1170.       vTopPick := NewValue;
  1171.       vActivePick := 1;
  1172.       DisplayAllPicks;
  1173.    end;
  1174. end; {JumpEngine}
  1175.  
  1176. procedure ListOBJ.ScrollJumpV(X,Y:byte);
  1177. {}
  1178. var
  1179.   NewValue: LongInt;
  1180. begin
  1181.    NewValue := (X * vTotPicks) div Y;
  1182.    JumpEngine(vTotPicks,NewValue)
  1183. end; {ListOBJ.ScrollJumpV}
  1184.  
  1185. procedure ListOBJ.ScrollJumpH(X,Y:byte);
  1186. {}
  1187. var
  1188.   NewValue: LongInt;
  1189. begin
  1190.    NewValue := (X * vTotPicks) div Y;
  1191.    JumpEngine(vTotPicks,NewValue)
  1192. end; {ListOBJ.ScrollJumpH}
  1193.  
  1194. procedure ListOBJ.ScrollLeft;
  1195. {}
  1196. begin
  1197.    if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
  1198.       ScrollUp
  1199.    else
  1200.       if vActivePick > vRows then {not in first column}
  1201.       begin
  1202.          DisplayPick(vActivePick,false);
  1203.          vActivePick := vActivePick - vRows;
  1204.          DisplayPick(vActivePick,True);
  1205.       end
  1206.       else if vTopPick > vRows then                      {leftmost column}
  1207.       begin
  1208.          vTopPick := vTopPick - vRows;
  1209.          DisplayAllPicks;
  1210.       end
  1211.       else
  1212.       begin
  1213.          vTopPick := 1;
  1214.          vActivePick := 1;
  1215.          DisplayAllPicks;
  1216.       end;
  1217. end; {ListOBJ.ScrollLeft}
  1218.  
  1219. procedure ListOBJ.ScrollRight;
  1220. {}
  1221. begin
  1222.    if (vCols = 1) or ((vCols = 2) and not vUselastCol) then
  1223.       ScrollDown
  1224.    else
  1225.       if (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) {not in last column}
  1226.       or (vTopPick + (vRows*(vCols -ord(not vUseLastCol))) >= vTotPicks) then
  1227.       begin
  1228.          DisplayPick(vActivePick,false);
  1229.          vActivePick := vActivePick + vRows;
  1230.          if vTopPick + pred(vActivePick) > vTotPicks then
  1231.             vActivePick := succ(vTotPicks - vTopPick);
  1232.          DisplayPick(vActivePick,True);
  1233.       end
  1234.       else 
  1235.       begin
  1236.          vTopPick := vTopPick + vRows;
  1237.          if vTopPick + pred(vActivePick) > vTotPicks then
  1238.            vActivePick := succ(vTotPicks - vTopPick);
  1239.          DisplayAllPicks;
  1240.       end;
  1241. end; {ListOBJ.ScrollRight}
  1242.  
  1243. procedure ListOBJ.ScrollFarRight;
  1244. {}
  1245. begin
  1246.    while (vActivePick < pred(vCols -ord(not vUseLastCol)) * vRows) do
  1247.       inc(vActivePick,vRows);
  1248.    while (vTopPick + (vCols -ord(not vUseLastCol)) * vRows < vTotPicks)
  1249.    and   (vTopPick + pred(vActivePick) + vRows <= vTotPicks) do
  1250.       inc(vTopPick,vRows);
  1251.    DisplayAllPicks;
  1252. end; {ListOBJ.ScrollFarRight}
  1253.  
  1254. procedure ListOBJ.ScrollFarLeft;
  1255. {}
  1256. begin
  1257.    while vActivePick - vRows > 0 do
  1258.      dec(vActivePick,vRows);
  1259.    vTopPick := 1;
  1260.    DisplayAllPicks;
  1261. end; {ListOBJ.ScrollFarLeft}
  1262.  
  1263. procedure ListOBJ.ScrollPgDn;
  1264. {}
  1265. begin
  1266.    if pred(vTopPick + vRows) < vTotPicks then
  1267.    begin
  1268.       vTopPick := vTopPick + vRows;
  1269.       vActivePick := 1;
  1270.       DisplayAllPicks;
  1271.    end;
  1272. end; {ListOBJ.ScrollPgDn}
  1273.  
  1274. procedure ListOBJ.ScrollPgUp;
  1275. {}
  1276. begin
  1277.    if vTopPick > 1 then
  1278.    begin
  1279.       vTopPick := vTopPick - vRows;
  1280.       if vTopPick < 1 then
  1281.          vTopPick := 1;
  1282.       DisplayAllPicks;
  1283.    end;
  1284. end; {ListOBJ.ScrollPgUp}
  1285.  
  1286. procedure ListOBJ.ScrollLast;
  1287. {}
  1288. begin
  1289.    if vTopPick + pred((vCols -ord(not vUseLastCol)) * vRows) >= vTotPicks then {last node on display}
  1290.    begin
  1291.       DisplayPick(vActivePick,False);
  1292.       vActivePick := succ(vTotPicks - vTopPick);
  1293.       DisplayPick(vActivePick,True);
  1294.    end
  1295.    else
  1296.    begin
  1297.      vTopPick := vTotPicks;
  1298.      vActivePick := 1;
  1299.      DisplayAllPicks;
  1300.    end;
  1301. end; {ListOBJ.ScrollLast}
  1302.  
  1303. procedure ListOBJ.ScrollFirst;
  1304. {}
  1305. begin
  1306.    vTopPick := 1;
  1307.    vActivePick := 1;
  1308.    DisplayAllPicks;
  1309. end; {ListOBJ.ScrollFirst}
  1310.  
  1311. procedure ListOBJ.ToggleSelect;
  1312. {}
  1313. begin
  1314.    SetStatus(pred(vTopPick+vActivePick), 0,not GetStatus(pred(vTopPick+vActivePick),0));
  1315.    if pred(vTopPick + vActivePick) < vTotPicks then
  1316.       ScrollDown
  1317.    else
  1318.       DisplayPick(vActivePick,True);
  1319. end; {of ListOBJ.ToggleSelect}
  1320.  
  1321. function ListOBJ.TargetPick(X,Y:byte): Integer;
  1322. {return the pick number of the pick pointed to by
  1323.  the coordinates X,Y. If no pick is at those coordinates, a
  1324.  0 is returned}
  1325. begin
  1326.    if  (X >= vZone.X1 + vMargin.X1)
  1327.    and (X <= vZone.X2 - vMargin.X2)
  1328.    and (Y >= vZone.Y1 + vMargin.Y1)
  1329.    and (Y <= vZone.Y1 + vMargin.Y1 + pred(vRows))
  1330.    then
  1331.    begin
  1332.       X := succ(X - vZone.X1 - vMargin.X1);
  1333.       Y := succ(Y - vZone.Y1 - vMargin.Y1);
  1334.       if X mod vRealColWidth = 0 then
  1335.          X := X div vRealColWidth
  1336.       else
  1337.          X := succ(X div vRealColWidth);
  1338.       if (X < vCols)
  1339.       or ((X = vCols) and vUseLastCol) then
  1340.       begin
  1341.           if vTopPick + pred(pred(X)*vRows + Y) <= vTotPicks then
  1342.           begin
  1343.              TargetPick := pred(X)*vRows + Y;
  1344.              exit;
  1345.           end;
  1346.       end;
  1347.    end;
  1348.    TargetPick := 0;
  1349. end; {ListOBJ.TargetPick}
  1350.  
  1351. procedure ListOBJ.MouseChoose(KeyX,KeyY:byte);
  1352. {}
  1353. var
  1354.    HitPick : integer;
  1355. begin
  1356.    HitPick := TargetPick(KeyX,KeyY);
  1357.    if HitPick <> 0 then
  1358.    begin
  1359.       DisplayPick(vActivePick,false);
  1360.       vActivePick := HitPick;
  1361.       SetStatus(pred(vTopPick+vActivePick),0,not GetStatus(pred(vTopPick+vActivePick),0));
  1362.       DisplayPick(vActivePick,True);
  1363.    end;
  1364. end; {ListOBJ.MouseChoose}
  1365.  
  1366. procedure ListOBJ.Show;
  1367. {}
  1368. begin
  1369.    if vListAssigned = false then
  1370.       Error(1)
  1371.    else
  1372.    begin
  1373.       if not vListVisible then
  1374.       begin
  1375.          vWin^.Draw;
  1376.          RefreshList;
  1377.          vListVisible := true
  1378.       end;
  1379.    end;
  1380. end; {ListOBJ.Show}
  1381.  
  1382. procedure ListOBJ.Go;
  1383. {}
  1384. var
  1385.    Finished: boolean;
  1386.    Mvisible: boolean;
  1387.    Kdouble: boolean;
  1388.    K: word;
  1389.    X,Y :byte;
  1390.    CursX,CursY: byte;
  1391.    Msg : string;
  1392.    CX,CY,CT,CB:byte;
  1393.  
  1394.        procedure ProcessAction(Act: tListAction);
  1395.        {}
  1396.        begin
  1397.           case Act of
  1398.              Finish: begin
  1399.              (*  1.10c
  1400.                 K := 0;
  1401.              *)
  1402.                 Finished := true;
  1403.                 end;
  1404.              Refresh: begin
  1405.                 K := 0;
  1406.                 RefreshList;
  1407.                 end;
  1408.              None:; {nothing!}
  1409.           end; {case}
  1410.        end; {ProcessAction}
  1411.  
  1412. begin
  1413.    if Monitor^.ColorOn then
  1414.       with Screen do
  1415.       begin
  1416.          CursSave;
  1417.          CX := WhereX;
  1418.          CY := WhereY;
  1419.          CT := CursTop;
  1420.          CB := CursBot;
  1421.          CursOff;
  1422.       end;
  1423.    Mvisible := Mouse.Visible;
  1424.    Show;
  1425.    kDouble := Key.GetDouble;
  1426.    if not kDouble then
  1427.       Key.SetDouble(true);
  1428.    Mouse.Show;
  1429.    Finished := false;
  1430.    repeat
  1431.       CursX := Screen.WhereX;
  1432.       CursY := Screen.WhereY;
  1433.       vWin^.DrawHorizBar(pred(vTopPick+vActivePick),vTotPicks);
  1434.       vWin^.DrawVertBar(pred(vTopPick+vActivePick),vTotPicks);
  1435.       Screen.GotoXY(CursX,CursY);
  1436.       K := Key.GetKey;
  1437.       X := Key.LastX;
  1438.       Y := Key.LastY;
  1439.       vWin^.Winkey(K,X,Y);
  1440.       ProcessAction(CharTask(K,X,Y,pred(vTopPick+vActivePick)));
  1441.       if (K = LookTOT^.ListEndKey) or (K = LookTOT^.ListEscKey) then
  1442.          Finished := true
  1443.       else if (K = LookTOT^.ListToggleKey) and vAllowToggle then
  1444.          ToggleSelect
  1445.       else if (K = LookTOT^.ListTagKey) and vAllowToggle then
  1446.          TagAll(true)
  1447.       else if (K = LookTOT^.ListUnTagKey) and vAllowToggle then
  1448.          TagAll(false)
  1449.       else
  1450.          case K of
  1451.          13: if vAllowToggle = false then
  1452.                 Finished := true
  1453.              else
  1454.                 ToggleSelect;
  1455.          600: Finished := true; {window close}
  1456.          601: ResetDimensions;
  1457.          602: RefreshList;
  1458.          610,328,584: ScrollUp; {1.00d}
  1459.          611,336,592: ScrollDown;
  1460.          612,331,589: ScrollLeft;
  1461.          613,333,587: ScrollRight;
  1462.          513: MouseChoose(X,Y);  {leftMouse}
  1463.          523: if TargetPick(X,Y) <> 0 then
  1464.                begin
  1465.                   MouseChoose(X,Y);
  1466.                   Finished := True;
  1467.                   Mouse.WaitForRelease;  {Thanks Bill -- 1.10e}
  1468.                end;
  1469.          337: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgDn}
  1470.                  ScrollPgDn
  1471.               else
  1472.                  ScrollRight;
  1473.          329: if (vCols = 1) or ((vCols = 2) and not vUselastCol) then {PgUp}
  1474.                  ScrollPgUp
  1475.               else
  1476.                  ScrollLeft;
  1477.          335: ScrollFarRight;
  1478.          327: ScrollFarLeft;
  1479.          388: ScrollFirst;
  1480.          374: ScrollLast;
  1481.          614: begin  {vertical scroll bar}
  1482.                  if X = 1 then
  1483.                     ScrollFirst
  1484.                  else if X = Y then
  1485.                     ScrollLast
  1486.                  else
  1487.                     ScrollJumpV(X,Y); {vertical scroll bar}
  1488.               end;
  1489.          615: begin {horizontal scroll bar}
  1490.                  if X = 1 then
  1491.                     ScrollFirst
  1492.                  else if X = Y then
  1493.                     ScrollLast
  1494.                  else
  1495.                     ScrollJumpH(X,Y); {vertical scroll bar}
  1496.               end;
  1497.          end; {case}
  1498.    until Finished;
  1499.    vLastKey := K;
  1500.    if Mvisible then
  1501.       Mouse.Show
  1502.    else
  1503.       Mouse.Hide;
  1504.    if Monitor^.ColorOn then
  1505.       with Screen do
  1506.       begin
  1507.          GotoXY(CX,CY);
  1508.          CursSize(CT,CB);
  1509.       end;
  1510.    Key.SetDouble(KDouble);
  1511. end; {ListOBJ.Go}
  1512.  
  1513. function ListOBJ.LastKey:word;
  1514. {}
  1515. begin
  1516.    LastKey := vLastKey;
  1517. end; {ListOBJ.LastKey}
  1518.  
  1519. procedure ListOBJ.Remove;
  1520. {}
  1521. begin
  1522.    vWin^.Remove;
  1523. end; {ListOBJ.Remove}
  1524.  
  1525. function ListOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction; 
  1526. {}
  1527. begin
  1528.    CharTask := vCharHook(K,X,Y,HiPick);
  1529. end; {ListOBJ.CharTask}
  1530.  
  1531. function ListOBJ.MessageTask(HiPick:longint):string; 
  1532. {}
  1533. begin
  1534.    MessageTask := vMsgHook(HiPick);
  1535. end; {ListOBJ.MessageTask}
  1536.  
  1537. function ListOBJ.GetString(Pick, Start,Finish: longint):string;
  1538. {abstract}
  1539. begin end;
  1540.  
  1541. function ListOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1542. {abstract}
  1543. begin end;
  1544.  
  1545. procedure ListObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1546. {abstract}
  1547. begin end;
  1548.  
  1549. procedure ListOBJ.TagAll(On:boolean);
  1550. {}
  1551. begin end;
  1552.  
  1553. destructor ListOBJ.Done;
  1554. {}
  1555. begin
  1556.    dispose(vWin,Done);
  1557. end;  {ListOBJ.Done}
  1558. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  1559. {                                                 }
  1560. {    L i s t A r r a y O B J    M E T H O D S     }
  1561. {                                                 }
  1562. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  1563. constructor ListArrayOBJ.Init;
  1564. {}
  1565. begin
  1566.    ListObj.Init;
  1567.    vLinkList := Nil;
  1568. end; {ListArrayOBJ.Init}
  1569.  
  1570. procedure ListArrayOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte; Selectable: boolean);
  1571. {}
  1572. var
  1573.   L : Longint;
  1574.   Dummy: byte;
  1575.   Result : integer;
  1576. begin
  1577.    vArrayPtr := @StrArray;
  1578.    vStrLength := StrLength;
  1579.    vTotPicks := Total;
  1580.    vListAssigned := true;
  1581.    vAllowToggle := Selectable;
  1582.    if vAllowToggle then {assign a linked list to record selections}
  1583.    begin
  1584.       New(vLinkList,Init);           {1.00i}
  1585.       with vLinkList^ do
  1586.       begin
  1587.          Dummy := 0;
  1588.          For L := 1 to Total do
  1589.          begin
  1590.             Result := Add(Dummy,0);
  1591.             if Result <> 0 then
  1592.             begin
  1593.                Dispose(vLinkList,Done);
  1594.                vAllowToggle := false;
  1595.             end;
  1596.          end;
  1597.       end;
  1598.    end;
  1599. end; {ListArrayOBJ.AssignList}
  1600.  
  1601. procedure ListArrayOBJ.SetTagging(On:boolean);
  1602. {}
  1603. begin
  1604.    if On and (vLinkList <> Nil) then
  1605.       vAllowToggle := true
  1606.    else
  1607.       vAllowToggle := false;
  1608. end; {ListOBJ.SetTagging}
  1609.  
  1610. function ListArrayOBJ.GetString(Pick, Start,Finish: longint):string;
  1611. {}
  1612. var
  1613.   W : longint;
  1614.   TempStr : String;
  1615.   ArrayOffset: word;
  1616. begin
  1617.    {move array string to Temp}
  1618.    W := pred(Pick) * succ(vStrLength);
  1619.    ArrayOffset := Ofs(vArrayPtr^) + W;
  1620.    Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  1621.    Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  1622.    if Start < 0 then Start := 0;
  1623.    if Finish < 0 then Finish := 0;
  1624.    {validate Start and Finish Parameters}
  1625.    if ((Finish = 0) and (Start = 0))
  1626.    or (Start > Finish) then   {get full string}
  1627.    begin
  1628.       Start := 1;
  1629.       Finish := 255;
  1630.    end
  1631.    else if Finish - Start > 254 then      {too long to fit in string}
  1632.       Finish := Start + 254;
  1633.    if Finish > vStrLength then
  1634.       Finish := vStrLength;
  1635.    if (Start > vStrLength) then
  1636.       GetString := ''
  1637.    else
  1638.    begin
  1639.       GetString := copy(TempStr,Start,succ(Finish - Start));
  1640.    end;
  1641. end; {ListArrayOBJ.GetString}
  1642.  
  1643. function ListArrayOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1644. {}
  1645. begin
  1646.    if vAllowToggle then  {1.00f}
  1647.       GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos)
  1648.    else
  1649.       getStatus := false;
  1650. end; {ListArrayOBJ.GetStatus}
  1651.  
  1652. procedure ListArrayObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1653. {}
  1654. begin
  1655.    if vAllowToggle then  {1.00f}
  1656.       vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1657. end; {ListArrayObj.SetStatus}
  1658.  
  1659. procedure ListArrayOBJ.TagAll(On:boolean);
  1660. {}
  1661. var NodeP : DLLNodePtr;
  1662. begin
  1663.    NodeP := vLinkList^.StartNodePtr;
  1664.    while NodeP <> Nil do
  1665.    begin
  1666.       NodeP^.SetStatus(0,On);
  1667.       NodeP := NodeP^.NextPtr;
  1668.    end;
  1669.    DisplayAllPicks;
  1670. end; {ListOBJ.TagAll}
  1671.  
  1672. destructor ListArrayOBJ.Done;
  1673. {}
  1674. begin
  1675.    if vLinkList <> nil then
  1676.       Dispose(vLinkList,Done);
  1677.    ListObj.Done;
  1678. end; {ListArrayOBJ.Done}
  1679. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1680. {                                               }
  1681. {    L i s t L i n k O B J    M E T H O D S     }
  1682. {                                               }
  1683. {|||||||||||||||||||||||||||||||||||||||||||||||}
  1684. constructor ListLinkOBJ.Init;
  1685. {}
  1686. begin
  1687.    ListObj.Init;
  1688.    vLinkList := nil;
  1689. end; {ListLinkOBJ.Init}
  1690.  
  1691. procedure ListLinkOBJ.AssignList(var LinkList: DLLOBJ);
  1692. {}
  1693. begin
  1694.    vLinkList := @LinkList;
  1695.    vTotPicks := LinkList.TotalNodes;
  1696.    vListAssigned := true;
  1697. end; {ListLinkOBJ.AssignList}
  1698.  
  1699. function ListLinkOBJ.ListPtr: DLLPtr;
  1700. {}
  1701. begin
  1702.    ListPtr := vLinkList;
  1703. end; {ListLinkOBJ.ListPtr}
  1704.  
  1705. function ListLinkOBJ.GetString(Pick, Start,Finish: longint):string;
  1706. {}
  1707. var TempPtr : DLLNodePtr;
  1708. begin
  1709.    TempPtr := vLinkList^.NodePtr(Pick);
  1710.    if TempPtr <> Nil then
  1711.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  1712.    GetString := vLinkList^.GetStr(TempPtr,Start,Finish);
  1713. end; {ListLinkOBJ.GetString}
  1714.  
  1715. function ListLinkOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1716. {}
  1717. begin
  1718.    GetStatus := vLinkList^.NodePtr(Pick)^.GetStatus(BitPos);
  1719. end; {ListLinkOBJ.GetStatus}
  1720.  
  1721. procedure ListLinkObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1722. {}
  1723. begin
  1724.    vLinkList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1725. end;  {ListLinkObj.SetStatus}
  1726.  
  1727. procedure ListLinkOBJ.TagAll(On:boolean);
  1728. {}
  1729. var NodeP : DLLNodePtr;
  1730. begin
  1731.    NodeP := vLinkList^.StartNodePtr;
  1732.    while NodeP <> Nil do
  1733.    begin
  1734.       NodeP^.SetStatus(0,On);
  1735.       NodeP := NodeP^.NextPtr;
  1736.    end;
  1737.    DisplayAllPicks;
  1738. end; {ListOBJ.TagAll}
  1739.  
  1740. procedure ListLinkOBJ.RefeshList; {1.10c}
  1741. {Thanks Peter!}
  1742. begin
  1743.    if vLinkList <> nil then
  1744.    begin
  1745.       vTotPicks := vLinkList^.TotalNodes;
  1746.       ListOBJ.RefreshList;
  1747.    end;
  1748. end; {ListLinkOBJ.RefreshList}
  1749.  
  1750. destructor ListLinkOBJ.Done;
  1751. {}
  1752. begin
  1753.    ListObj.Done;
  1754. end; {ListLinkOBJ.Done}
  1755. {|||||||||||||||||||||||||||||||||||||||||||||}
  1756. {                                             }
  1757. {    L i s t D i r O B J    M E T H O D S     }
  1758. {                                             }
  1759. {|||||||||||||||||||||||||||||||||||||||||||||}
  1760. constructor ListDirOBJ.Init;
  1761. {}
  1762. begin
  1763.    ListObj.Init;
  1764.    new(vFileList,Init);
  1765.    vMsgActive := true;
  1766.    vDualColors := true;
  1767.    vColWidth := 15;
  1768.    vWin^.SetSize(10,5,71,20,1);
  1769.    vChangeDir := true; {1.00g}
  1770. end; {ListDirOBJ.Init}
  1771.  
  1772. procedure ListDirOBJ.SetChangeDir(On:boolean);   {1.00g}
  1773. {}
  1774. begin
  1775.    vChangeDir := On;
  1776. end; {ListDirOBJ.SetChangeDir}
  1777.  
  1778. procedure ListDirOBJ.ReadFiles(FileMasks:string; FileAttrib: word);  {1.00k}
  1779. {}
  1780. var B:byte;
  1781. begin
  1782.    vActiveDir := '';
  1783.    if FileMasks = '' then
  1784.    begin
  1785.       FileMasks := '*.*';
  1786.       vFileList^.SetFileDetails(FileMasks,FileAttrib);        {1.10a}
  1787.    end
  1788.    else if (pos(':',Filemasks)<>0) or (pos('\',Filemasks)<>0) then
  1789.    begin
  1790.       B := length(FileMasks);
  1791.       while not (FileMasks[B] in [':','\']) do
  1792.         dec(B);
  1793.       vActiveDir := copy(FileMasks,1,B);
  1794.       vFileList^.SetFileDetails(copy(FileMasks,succ(B),12),FileAttrib);  {1.10a}
  1795.    end
  1796.    else
  1797.       vFileList^.SetFileDetails(FileMasks,FileAttrib);  {1.10a}
  1798.    if vActiveDir <> '' then
  1799.    begin
  1800.       {$I-}
  1801.       ChDir(vActiveDir);
  1802.       {$I-}
  1803.       if IOResult <> 0 then
  1804.       begin
  1805.          vActiveDir := '';
  1806.          Filemasks := copy(FileMasks,succ(B),12);
  1807.       end;
  1808.    end;
  1809.    if vActiveDir = '' then
  1810.    begin
  1811.       GetDir(0,vActiveDir);
  1812.       if not (vActiveDir[length(vActiveDir)] in [':','\']) then
  1813.          vActiveDir := vActiveDir + '\';
  1814.       Filemasks := vActiveDir+Filemasks;
  1815.    end;
  1816.    Win^.SetTitle(FileMasks);
  1817.    vFileList^.FillList;
  1818.    vTotPicks := vFileList^.TotalNodes;
  1819.    vListAssigned := true;
  1820. end; {ListDirOBJ.ReadFiles}
  1821.  
  1822. function ListDirOBJ.GetString(Pick, Start,Finish: longint):string;
  1823. {}
  1824. var TempPtr : DLLNodePtr;
  1825. begin
  1826.    TempPtr := vFileList^.NodePtr(Pick);
  1827.    if TempPtr <> Nil then
  1828.       vFileList^.ShiftActiveNode(TempPtr,Pick);
  1829.    GetString := vFileList^.GetStr(TempPtr,Start,Finish);
  1830. end; {ListDirOBJ.GetString}
  1831.  
  1832. function ListDirOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
  1833. {}
  1834. var
  1835.   FileInfo: tFileInfo;
  1836.   HitPick : integer;
  1837. begin
  1838.    CharTask := vCharHook(K,X,Y,HiPick); {1.00h}
  1839.    if (K = 13) or (K = 523) then
  1840.    begin
  1841.       if K = 523 then
  1842.       begin
  1843.          HitPick := TargetPick(X,Y);
  1844.          if HitPick <> 0 then
  1845.             HiPick := pred(vTopPick+HitPick)
  1846.          else
  1847.             exit;
  1848.       end;
  1849.       vFileList^.GetFileRecord(FileInfo,HiPick);
  1850.       if SubDirectory(FileInfo.Attr) and vChangeDir then {1.00g}
  1851.       begin
  1852.          {$I-}
  1853.          ChDir(FileInfo.FileName);
  1854.          {$I+}
  1855.          if IOResult = 0 then
  1856.          begin
  1857.             vFileList^.FillList;
  1858.             vTotPicks := vFileList^.TotalNodes;
  1859.             vTopPick := 1;
  1860.             vActivePick := 1;
  1861.             CharTask := Refresh;
  1862.             GetDir(0,vActiveDir);
  1863.             if not (vActiveDir[length(vActiveDir)] in [':','\']) then
  1864.                vActiveDir := vActiveDir + '\';
  1865.             Win^.SetTitle(vActiveDir+vFileList^.GetFileMask);
  1866.             Win^.Refresh;
  1867.          end;
  1868.       end
  1869.       else if (K = 13)
  1870.            (*
  1871.            or ((K=513) and (vAllowToggle = false))
  1872.            *) then                                       {1.10c}
  1873.          CharTask := Finish;
  1874.    end;
  1875. end; {ListDirOBJ.CharTask}
  1876.  
  1877. function ListDirOBJ.GetHiString:string;
  1878. {}
  1879. begin
  1880.    GetHiString := vActiveDir + GetString(pred(vTopPick+vActivePick),0,0);
  1881. end; {ListDirOBJ.GetHiString}
  1882.  
  1883. function ListDirOBJ.MessageTask(Hi:longint): string;
  1884. {}
  1885. var TempPtr : DLLNodePtr;
  1886. begin
  1887.    TempPtr := vFileList^.NodePtr(Hi);
  1888.    if TempPtr <> Nil then
  1889.       vFileList^.ShiftActiveNode(TempPtr,Hi);
  1890.    MessageTask := vFileList^.GetLongStr(TempPtr);
  1891. end; {ListDirOBJ.MessageTask}
  1892.  
  1893. function ListDirOBJ.GetStatus(Pick:longint; BitPos:byte): boolean;
  1894. {}
  1895. begin
  1896.    GetStatus := vFileList^.NodePtr(Pick)^.GetStatus(BitPos);
  1897. end; {ListDirOBJ.GetStatus}
  1898.  
  1899. procedure ListDirObj.SetStatus(Pick:longint; BitPos:byte;On:boolean);
  1900. {}
  1901. begin
  1902.    vFileList^.NodePtr(Pick)^.SetStatus(BitPos,On);
  1903. end;  {ListDirObj.SetStatus}
  1904.  
  1905. procedure ListDirOBJ.TagAll(On:boolean);
  1906. {}
  1907. var NodeP : DLLNodePtr;
  1908. begin
  1909.    NodeP := vFileList^.StartNodePtr;
  1910.    while NodeP <> Nil do
  1911.    begin
  1912.       NodeP^.SetStatus(0,On);
  1913.       NodeP := NodeP^.NextPtr;
  1914.    end;
  1915.    DisplayAllPicks;
  1916. end; {ListOBJ.TagAll}
  1917.  
  1918. function ListDirOBJ.FileList: FileDLLPtr;
  1919. {}
  1920. begin
  1921.    FileList := vFileList;
  1922. end; {ListDirOBJ.FileList}
  1923.  
  1924. procedure ListDirOBJ.Go;
  1925. {}
  1926. var
  1927.   D: string;
  1928. begin
  1929.    GetDir(0,D);
  1930.    vTotPicks := vFileList^.TotalNodes; {1.10d}
  1931.    ListOBJ.Go;
  1932.    {$I-}
  1933.    ChDir(D);
  1934.    {$I+}
  1935.    if IOResult <> 0 then
  1936.       {whogivesashit};
  1937. end; {ListDirOBJ.Go}
  1938.  
  1939. destructor ListDirOBJ.Done;
  1940. {}
  1941. begin
  1942.    ListObj.Done;
  1943.    dispose(vFileList,Done);
  1944. end; {ListDirOBJ.Done}
  1945. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1946. {                                                     }
  1947. {    L i s t D i r S o r t O B J    M E T H O D S     }
  1948. {                                                     }
  1949. {|||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1950. constructor ListDirSortOBJ.Init;
  1951. {}
  1952. begin
  1953.    ListDirObj.Init;
  1954. end; {ListDirSortOBJ.Init}
  1955.  
  1956. function ListDirSortOBJ.PromptAndSort: boolean;
  1957. {}
  1958. var
  1959.   Manager: WinFormOBJ;
  1960.   Control:  ControlKeysIOOBJ;
  1961.   OK,Cancel: Strip3DIOOBJ;
  1962.   SField,SOrder: RadioIOOBJ;
  1963.   Result: tAction;
  1964.   SortField: byte;
  1965.   SortOrder: boolean;
  1966. begin
  1967.    Control.Init; {Tab, STab, Enter, Esc}
  1968.    OK.Init(23,5,'   ~O~K   ',Finished);
  1969.    OK.SetHotKey(79);{O}
  1970.    Cancel.Init(23,8,' ~C~ancel ',Escaped);
  1971.    Cancel.SetHotKey(67); {C}
  1972.    with SField do
  1973.    begin
  1974.       Init(3,2,18,6,'Sort on:');
  1975.       AddItem('Nat~u~ral DOS',ord('U'),vFileList^.vSortID = 0);
  1976.       AddItem('~N~ame',ord('N'),vFileList^.vSortID = 1);
  1977.       AddItem('~E~xt', ord('E'),vFileList^.vSortID = 2);
  1978.       AddItem('~S~ize',ord('S'),vFileList^.vSortID = 3);
  1979.       AddItem('~T~ime',ord('T'),vFileList^.vSortID = 4);
  1980.       SetID(1);
  1981.    end;
  1982.    with SOrder do
  1983.    begin
  1984.       Init(3,9,18,3,'Sort Order:');
  1985.       AddItem('~A~scending',ord('A'),vFileList^.vSortAscending);
  1986.       AddItem('~D~escending',ord('D'),not vFileList^.vSortAscending);
  1987.    end;
  1988.    with Manager do
  1989.    begin
  1990.      Init;
  1991.      AddItem(Control);
  1992.      AddItem(SField);
  1993.      AddItem(SOrder);
  1994.      AddItem(OK);
  1995.      AddItem(Cancel);
  1996.      SetActiveItem(1);
  1997.      Win^.SetSize(25,2,58,15,1);
  1998.      Win^.SetTitle('Directory Sort Options');
  1999.      Draw;
  2000.      Result := Go;
  2001.      SortField := pred(Sfield.GetValue);
  2002.      SortOrder := (SOrder.GetValue = 1);
  2003.      Control.Done;
  2004.      OK.Done;
  2005.      Cancel.Done;
  2006.      SField.Done;
  2007.      SOrder.Done;
  2008.      Done;
  2009.    end;
  2010.    if Result = Finished then
  2011.    begin
  2012.       vFileList^.Sort(SortField,SortOrder);
  2013.       vTopPick := 1;
  2014.       vActivePick := 1;
  2015.       PromptAndSort := true;
  2016.    end
  2017.    else
  2018.       PromptAndSort := false;
  2019. end; {ListDirSortOBJ.PromptAndSort}
  2020.  
  2021. function ListDirSortOBJ.CharTask(var K:word; var X,Y: byte;HiPick:longint): tListAction;
  2022. {}
  2023. var
  2024.   FileInfo: tFileInfo;
  2025.   D : string;
  2026.   MP: longint;
  2027. begin
  2028.    CharTask := vCharHook(K,X,Y,HiPick); {1.00h}
  2029.    if (K = 83) or (K = 115) or (K = 514) then {'S','s',rightbutton}
  2030.    begin
  2031.       if PromptAndSort then
  2032.          CharTask := Refresh
  2033.       else
  2034.          CharTask := none;
  2035.    end
  2036.    else
  2037.       CharTask := ListDirOBJ.CharTask(K,X,Y,HiPick);
  2038. end; {ListDirSortOBJ.CharTask}
  2039.  
  2040. destructor ListDirSortOBJ.Done;
  2041. {}
  2042. begin
  2043.    ListDirObj.Done;
  2044. end; {ListDirSortOBJ.Done}
  2045. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2046. {                                               }
  2047. {     U N I T   I N I T I A L I Z A T I O N     }
  2048. {                                               }
  2049. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2050.  
  2051. procedure ListInit;
  2052. {initilizes objects and global variables}
  2053. begin
  2054. end;
  2055.  
  2056. {end of unit - add initialization routines below}
  2057. {$IFNDEF OVERLAY}
  2058. begin
  2059.    ListInit;
  2060. {$ENDIF}
  2061. end.
  2062.  
  2063.  
  2064.  
  2065.